00010	BEGIN "PITCH"
00020	DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
00030	INTEGER I,J,K,L,M,N,P,Q,R,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,EOF;
00040	INTEGER II,JJ,P1,P2,P3,T1,T2,T3,T,DT,H,TAU1,TAU2;
00050	INTEGER ARRAY BUF,PITCH[0:1000];
00060	STRING FILEN,READ,READ1,FILEO,READ2;
00070	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00080	
00090	⊂ Three peaks are located, then tests are made on the middle
00100	   one to determine whether it should be reported or discarded;
00110	⊂ These peaks are P1, P2, and P3 with corresponding times of T1, T2 and T3;
00120	
00130	⊂ The conditions for discarding are
00140	    a) just getting started, P1=0
00150	   b) the middle peak is definitely smaller than one at the ends
00160	   c) the time interval between P1 and P2 is too small
00170	   d) the time interval is too large;
00180	
00190	FILEN←"FLTD.001[DAT,NJM]";
00200	OUTSTR("Type file name (CR for "&FILEN&".");
00210	IF (READ←INCHWL)≠"" THEN FILEN←READ ELSE READ←FILEN;
00220	  READ1←""; FOR I←0 STEP 1 UNTIL 6 DO BEGIN
00230	  READ2←READ[1 TO 1]; READ1←READ1&READ2; READ←READ[2 TO 6];
00240	  IF READ2="." THEN DONE; END;
00250	  FILEO←READ1&"PCH";
00260	  POINTY←POINT(12,PITCH[0],-1);
00270	TAU1←40;
00280	OUTSTR("Set TAU1 (CR for 40) ");IF (READ←INCHWL)≠"" THEN TAU1←CVD(READ);
00290	TAU2←140;
00300	OUTSTR("Set TAU2 (CR for 140) ");IF (READ←INCHWL)≠"" THEN TAU2←CVD(READ);
00310	DELTA←1200;
00320	OUTSTR("Type value for DELTA (CR for 1200) ");
00330	IF (READ←INCHWL)≠"" THEN DELTA←CVD(READ);
00340	CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00350	LOOKUP(CHAN1,FILEN,0);
00360	J←K←L←STATE←VAL←R←0;
00370	OUTSTR(CRLF&"Pitch  measure on file "&FILEN &CRLF&LF);
00380	OUTSTR("   T   P   A      T   P   A      T   P   A      T   P   A"&CRLF&LF);
00390	SETFORMAT(4,0); P←P1←P2←P3←T1←T2←T3←H←Q←0;
00400	WHILE EOF=0 DO BEGIN
00410	  FOR J←0 STEP 1 UNTIL 1000 DO BUF[J]←0;
00420	  ARRYIN(CHAN1,BUF[0],1000);
00430	  POINTX←POINT(12,BUF[0],-1);
00440	FOR I←0 STEP 1 UNTIL 2999 DO BEGIN
00450	    L←K*1500+I%2;
00460	    VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
00470	
00475	IF H>0 THEN IF VAL≤0 THEN IF L-T3>6 THEN T←L;
00480	
00490	IF VAL>0 THEN IF H≤0 THEN BEGIN
00500	  WHILE TRUE DO BEGIN
00505	
00510	
00515	    IF P<P3 THEN DONE;
00517	
00518	⊂    IF L-T<6 THEN DONE;
00519	
00520	    IF P1<DELTA THEN BEGIN
00530	      P1←P2; T1←T2; P2←P; T2←T3; DONE END;
00540	
00550	    IF T2-T1>TAU2 THEN BEGIN
00560	       P1←P2; T1←T2; P2←P; T2←T3; DONE END;
00570	
00580	    IF P2<DELTA THEN BEGIN
00590	      P2←P; T2←T3; DONE END;
00600	
00630	    IF T2-T1<TAU1 THEN BEGIN
00640	      IF P2>P1 THEN BEGIN
00650	        P1←P2; T1←T2; P2←P; T2←T3; DONE END ELSE BEGIN
00660	        P2←P; T2←T3; DONE END; END;
00670	
00680	    IF P2<P1 THEN IF P2<P THEN IF T3-T1<TAU2 THEN BEGIN
00690	      P2←P; T2←T3; DONE END;
00700	
00710	    OUTSTR(CVS(T1%10)&CVS(T2-T1)&CVS(P1 LSH -9)&"   ");
00720	    IF (R MOD 4)=3 THEN BEGIN OUTSTR(CRLF); R←0; END ELSE R←R+1;
00730	    TAU1←(2*TAU1+2*(T2-T1))%5;
00740	    IF TAU1<40 THEN TAU1←40;
00750	    TAU2←(4*TAU2+T2-T1) LSH -2;
00760	    IF TAU2>140 THEN TAU2←140;
00770	    Q←Q+1;
00780	    IDPB(T1%100,POINTY); IDPB(T2-T1,POINTY); IDPB((P1 LSH -9),POINTY);
00790	    P1←P2; T1←T2; P2←P; T2←T3; DONE END;
00800	  P3←P; T3←L; P←0; END;
00810	H←VAL;
00820	IF VAL>0 THEN P←P+VAL ELSE P←P-VAL;
00830	
00840	  END;
00850	K←K+1;
00860	
00870	END;
00880	
00890	CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
00900	ENTER(CHAN1,FILEO,0);
00910	ARRYOUT(CHAN1,PITCH[0],Q); RELEASE(CHAN1);
00920	END "PITCH";